home *** CD-ROM | disk | FTP | other *** search
/ TOS Silver 2000 / TOS Silver 2000.iso / programm / MM2_DEV / S / UTILITY / CONV_M2P.M < prev    next >
Encoding:
Text File  |  1991-11-20  |  3.0 KB  |  92 lines
  1. MODULE Conv_M2P;
  2.  
  3. (*
  4.  * Paßt M2P-Dateien automatisch auf neues Format an, wenn die neue Shell die
  5.  * Dateien sonst nicht mehr akzeptiert.
  6.  *
  7.  * Anwendung: Programm übersetzen und starten, dann mit dem File-Selektor
  8.  * die Verzeichnisse mit den M2P-Dateien aufsuchen und <OK> anklicken.
  9.  * Wiederholen, bis alle M2P-Dateien konvertiert. Dann <Abbruch> anklicken.
  10.  *)
  11.  
  12. IMPORT Block;
  13. FROM EasyGEM0 IMPORT ShowArrow, FormAlert;
  14. FROM EasyGEM1 IMPORT SelectFile, SelectMask;
  15. FROM MOSGlobals IMPORT fNoMatchingFiles, PathStr, FileStr;
  16. IMPORT Files, Binary;
  17. FROM FuncStrings IMPORT ConcStr;
  18. FROM Directory IMPORT Delete, DirQuery, DirQueryProc, DirEntry, FileAttrSet,
  19.         QueryFiles, SetFileAttr;
  20. FROM FileNames IMPORT SplitPath, PathConc;
  21. FROM SYSTEM IMPORT ADDRESS, ADR, TSIZE, BYTE, WORD, LONGWORD;
  22.  
  23. VAR ok: BOOLEAN; name: FileStr; but: CARDINAL; f: Files.File;
  24.     buf: ARRAY [1..60000] OF BYTE;
  25.  
  26. PROCEDURE process (REF path: ARRAY OF CHAR; dir: DirEntry): BOOLEAN;
  27.   
  28.   VAR origlen, len: LONGCARD; (*$Reg*)p: POINTER TO LONGCARD;
  29.       name: FileStr;
  30.       en, st: ADDRESS;
  31.   
  32.   PROCEDURE copy (ofs, add: LONGCARD);
  33.     BEGIN
  34.       st:= ADR(buf)+ofs;
  35.       en:= ADR(buf)+len;
  36.       Block.Copy (st, len-ofs, st+add);
  37.       Block.Clear (st, add);
  38.       INC (len, add);
  39.     END copy;
  40.     
  41.   BEGIN
  42.     name:= PathConc (path, dir.name);
  43.     Files.Open (f, name, Files.readOnly);
  44.     Binary.ReadBytes (f, ADR (buf), SIZE (buf), len);
  45.     IF len > SIZE (buf)-10000 THEN HALT (* Puffer ist zu klein *) END;
  46.     Files.Close (f);
  47.     origlen:= len;
  48.     p:= ADR (buf);
  49.     IF p^ = 10071898L + 00600000000L THEN (* MM2SHELL.M2P bis V2.2f *)
  50.       copy ($108E, 2*80+2);
  51.       p^:= 10071898L + 00700000000L
  52.     END;
  53.     IF p^ = 10071898L + 02600000000L THEN (* MM2TINYS.M2P bis V2.2f *)
  54.       copy ($1060, 2*80+2);
  55.       p^:= 10071898L + 02700000000L
  56.     END;
  57.     
  58.     (* ... hier sind neue Formate zu behandeln. *)
  59.     
  60.     (* Und nun neue Datei wieder schreiben *)
  61.     IF len = origlen THEN
  62.       FormAlert (1, ConcStr (ConcStr ('[0][Parameter-Datei|', name), '|ist bereits up-to-date. ][OK]'), but);
  63.     ELSE
  64.       Files.Create (f, name, Files.writeOnly, Files.replaceOld);
  65.       Binary.WriteBytes (f, ADR (buf), len);
  66.       Files.Close (f);
  67.       IF Files.State (f) < 0 THEN
  68.         FormAlert (1, ConcStr (ConcStr ('[0][Fehler beim Erzeugen von|', name), '][OK]'), but);
  69.       ELSE
  70.         FormAlert (1, ConcStr (ConcStr ('[0][Parameter-Datei|', name), '|wurde konvertiert. ][OK]'), but);
  71.       END;
  72.     END;
  73.     RETURN TRUE
  74.   END process;
  75.  
  76. VAR res: INTEGER;
  77.  
  78. BEGIN
  79.   ShowArrow;
  80.   FormAlert (1, '[0][ |*.M2P-Konvertierer |für Megamax Modula-2 | ][ OK ]', but);
  81.   SelectMask:= '*.M2P';
  82.   LOOP
  83.     name:= '';
  84.     SelectFile ('Wähle Verzeichnis', name, ok);
  85.     IF ~ok THEN EXIT END;
  86.     DirQuery (PathConc (name, '*.M2P'), QueryFiles, process, res);
  87.     IF res = fNoMatchingFiles THEN
  88.       FormAlert (1, '[0][Dies Verzeichnis enthält|keine M2P-Dateien.][OK]', but);
  89.     END;
  90.   END
  91. END Conv_M2P.
  92.